Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
ParcElems
Alloc
Syntax10b.Scn.Fnt
Syntax8i.Scn.Fnt
FoldElems
MarkElems
Alloc
MODULE Directories;	(* CS 10.10.95 based on Windows-FileDir from MH Feb 93 / 2.6.94 and PowerMac-Directories from HM Oct 95 *)
IMPORT
	(*SYSTEM,*) TextFrames, O:=Console, Out, Files, AmigaDos, Strings; (*,Unix,directory*)
CONST
	noErr* = 0;	(**no error*)
	badName* = 1;	(**bad file or directory name*)
	mediumFull* = 2;	(**disk or directory full*)
	mediumLocked* = 3;	(**hardware or software lock*)
	dirInUse* = 4;	(**directory in use or not empty*)
	notADir* = 5;	(**name does not specify a directory*)
	alreadyExists* = 6;	(**directory already exists*)
	otherError* = 7;	(**other OS-specific error*)
	delete* = 0; insert* = 1;  change* = 2; 	(** notify operations **)
	delimiter* = "/";	(** delimiter in path names **)
	Directory* = POINTER TO DirectoryDesc;
	Entry* = POINTER TO EntryDesc;
	DirectoryDesc* = RECORD
		path*: ARRAY 256 OF CHAR;
	END;
	EntryDesc* = RECORD
		dir*: Directory;
		name*: ARRAY 32 OF CHAR;
		hostname*: ARRAY 14 OF CHAR
	END;
	FileProc* = PROCEDURE (d: Directory; name: ARRAY OF CHAR; isDir: BOOLEAN; VAR continue: BOOLEAN);
	PathProc* = PROCEDURE (path: ARRAY OF CHAR; VAR continue: BOOLEAN);
	Notifier* = PROCEDURE (op: INTEGER; path, name: ARRAY OF CHAR);
	FileInfoBlockPtr=POINTER TO AmigaDos.FileInfoBlock;
(*	Directories = POINTER TO ARRAY OF Directory;*)
	res*: INTEGER;
	notify*: Notifier;
	dirTab: POINTER TO ARRAY OF Directory;
	startupPath: ARRAY 256 OF CHAR;	(*path containing the Oberon application*)
	nofPaths: INTEGER;
	CurrentDir: Directory;
PROCEDURE 
AppendFile (VAR path: ARRAY OF CHAR; filename: ARRAY OF CHAR);
	VAR i, j, max: LONGINT;
BEGIN
	i := 0; j := 0; max := LEN(path)-1;
	WHILE path[i] # 0X DO INC(i) END ;
	IF (i > 0) & (path[i-1] # delimiter) THEN path[i] := delimiter; INC(i) END ;
	WHILE (i < max) & (filename[j] # 0X) DO path[i] := filename[j]; INC(i); INC(j) END ;
	path[i] := 0X;
END AppendFile;
PROCEDURE 
InsertEntry* (D: Directory; e: Entry);
BEGIN
	(* No meaning under Unix. *)
END InsertEntry;
PROCEDURE 
RemoveEntry* (e: Entry);
BEGIN
	(* No meaning under Unix. *)
END RemoveEntry;
PROCEDURE 
ThisEntry* (D: Directory; VAR name: ARRAY OF CHAR): Entry;
BEGIN
	RETURN NIL;
END ThisEntry;
PROCEDURE 
ThisHostEntry* (D: Directory; VAR hostname: ARRAY OF CHAR): Entry;
BEGIN
	RETURN NIL;
END ThisHostEntry;
PROCEDURE 
ExpandPath (this: ARRAY OF CHAR; VAR absPath: ARRAY OF CHAR);
	current:ARRAY 256 OF CHAR;
	pwd:ARRAY 256 OF CHAR;
	fib : FileInfoBlockPtr;
	lock: AmigaDos.FileLockPtr;
BEGIN
	IF AmigaDos.GetCurrentDirName(current, LEN(current)) THEN
		COPY(this, absPath);
		IF AmigaDos.SetCurrentDirName(absPath) THEN
			IF AmigaDos.GetCurrentDirName(pwd, LEN(pwd)) THEN 
				COPY(pwd, absPath); 
				(* Now we have to check wether this really is a directory. SetCurrentDir() even works with Files!  <<FF *)
				lock := AmigaDos.Lock(absPath, AmigaDos.sharedLock);
				IF lock#0 THEN
					NEW(fib);
					IF AmigaDos.NameFromLock(lock, absPath) THEN END;
					IF AmigaDos.Examine(lock, fib^) THEN
						IF fib.dirEntryType<0 THEN 
							absPath[0] := 0X; 
						END;
					END;
					AmigaDos.UnLock(lock);
					fib := NIL;
				ELSE
					absPath[0] := 0X; (* couldn't lock dir/file *)
				END;
			ELSE
				absPath[0] := 0X;
			END;
			IF AmigaDos.SetCurrentDirName(current) THEN END;
		ELSE
			absPath[0] := 0X;
		END;
	ELSE
		absPath[0] := 0X;				
	END;
END ExpandPath;
PROCEDURE 
OpenDirectory (VAR absPath: ARRAY OF CHAR; VAR D: Directory);
BEGIN
	ExpandPath(absPath,absPath);
	IF absPath="" THEN
		D:=NIL;
	ELSE
		NEW(D);
		COPY(absPath,D.path);
	END;
END OpenDirectory;
PROCEDURE 
Map* (name: ARRAY OF CHAR; VAR hostname: ARRAY OF CHAR);
BEGIN
	COPY(name,hostname);
END Map;
PROCEDURE 
NextMapping* (VAR name: ARRAY OF CHAR);
BEGIN
	(* No meaning under Unix. *)
END NextMapping;
PROCEDURE 
Exists* (dir: Directory; VAR hostname: ARRAY OF CHAR): BOOLEAN;
	done:BOOLEAN;
	fullname:ARRAY 256 OF CHAR;
	lock: AmigaDos.FileLockPtr;
BEGIN
	COPY(dir.path,fullname);
	AppendFile(fullname,hostname);
	lock := AmigaDos.Lock(fullname, AmigaDos.sharedLock);
	IF lock#0 THEN
		AmigaDos.UnLock(lock);
		RETURN TRUE;
	END;
	RETURN FALSE;
END Exists;
PROCEDURE 
This*(path: ARRAY OF CHAR):Directory;
	D:Directory; 
	absPath:ARRAY 256 OF CHAR;
BEGIN
	ExpandPath(path,absPath);
	IF absPath="" THEN RETURN NIL END ;
	OpenDirectory(absPath,D);
	RETURN D;
END This;
PROCEDURE 
RenameEntry* (e: Entry; VAR new: ARRAY OF CHAR);
	name1, name2: ARRAY 256 OF CHAR;
BEGIN
	COPY(e.dir.path, name1);
	AppendFile(name1, e.name);
	COPY(e.dir.path, name2);
	AppendFile(name2, new);
	IF AmigaDos.Rename(name1, name2) THEN END;
	(* Files.Rename ! *)
	oldName,newName:ARRAY 32 OF CHAR;
BEGIN
	COPY(e.dir.path, oldName);
	COPY(e.dir.path, newName);
	AppendFile(oldName, e.name);
	AppendFile(newName, new);
	res := otherError;
	Files.Rename(oldName, newName, res);
	IF res = 0 THEN
		notify(delete, e.dir.path, e.name);
		COPY(new, e.name);
		notify(insert, e.dir.path, e.name);
		res := noErr;
	ELSE
		res := otherError;
	END;	
	res:=otherError;
END RenameEntry;
PROCEDURE 
DeleteFile* (dir: Directory; VAR name: ARRAY OF CHAR);
	fullname: ARRAY 256 OF CHAR;
BEGIN
	COPY(dir.path,fullname); AppendFile(fullname,name);
	Files.Delete(fullname,res);
END DeleteFile;
PROCEDURE 
GetHostname* (name: ARRAY OF CHAR; VAR hostname: ARRAY OF CHAR);
BEGIN
	COPY(name, hostname);
END GetHostname;
PROCEDURE 
Enumerate* (D: Directory; H: FileProc);
	fib: FileInfoBlockPtr;
	lock: AmigaDos.FileLockPtr;
	continue: BOOLEAN;
	PROCEDURE CheckDigit(ch: CHAR): BOOLEAN;
	BEGIN	RETURN (ch=".") OR ((ch>="0") & (ch<="9"));
	END CheckDigit;
	PROCEDURE CheckChar(ch: CHAR): BOOLEAN;
	BEGIN	RETURN CheckDigit(ch) OR ((ch>="A") & (ch<="Z")) OR ((ch>="a") & (ch<="z"));
	END CheckChar;
	PROCEDURE CheckName(name: ARRAY OF CHAR): BOOLEAN;
		i: INTEGER;
	BEGIN
		IF CheckDigit(name[0]) THEN RETURN TRUE END;
		WHILE name[i]#0X DO
			IF ~CheckChar(name[i]) THEN RETURN TRUE END;
			INC(i);
		END;
		RETURN FALSE; 
	END CheckName;
BEGIN
	lock := AmigaDos.Lock(D.path,AmigaDos.sharedLock);
	IF lock#0 THEN
		NEW(fib);
		IF AmigaDos.Examine(lock, fib^) THEN
			continue := TRUE;
			LOOP
				IF AmigaDos.ExNext(lock,fib^) THEN
					(* Check wether there are illegal characters in the filename <<FF *)
					IF ~CheckName(fib.fileName) THEN H(D, fib.fileName, fib.dirEntryType>0, continue) END;
					IF ~continue THEN EXIT END;
				ELSE
					IF AmigaDos.IoErr()=232 THEN EXIT END;  (* Check for NO_MORE_ENTRIES *)
				END;		
			END;
		END;
		AmigaDos.UnLock(lock);
		fib := NIL;
	END;	
END Enumerate;
PROCEDURE 
Current*():Directory;
	current:ARRAY 256 OF CHAR;
BEGIN
	IF CurrentDir=NIL THEN
		IF AmigaDos.GetCurrentDirName(current, LEN(current)) THEN END;
		CurrentDir:=This(current);
	END;
	RETURN CurrentDir;
END Current;
PROCEDURE 
Change*(path:ARRAY OF CHAR);
	D:Directory;
	rc:LONGINT;
	res: INTEGER;
	buf: ARRAY 256 OF CHAR;
BEGIN
	D:=This(path);
	IF D#NIL THEN
		Files.ChangeDirectory(path, res);
		IF res=0 THEN
		(*IF AmigaDos.SetCurrentDirName(path) THEN*)
			res:=noErr;
			CurrentDir:=D;
			notify(change,"","");
			RETURN;
		END;
	END;
	 (* Try to change relative to startup path *) 	(*<<FF 29.6.96*)
	COPY(startupPath, buf);
	AppendFile(buf, path);
	D := This(buf);
	Files.ChangeDirectory(buf, res);
	IF res=0 THEN
		res := noErr;
		CurrentDir := D;
		notify(change,"","");
	ELSE
		res := otherError;
	END;				
END Change;
PROCEDURE 
 Startup* (): Directory;
BEGIN
	RETURN This(startupPath)
END Startup;
PROCEDURE 
Split (path: ARRAY OF CHAR; VAR path0, dirName: ARRAY OF CHAR);
	VAR i, j: INTEGER;
BEGIN
	i := 0; j := 0;
	WHILE path[i] # 0X DO
		path0[i] := path[i];
		IF path[i] = delimiter THEN j := i END ;
		INC(i)
	END ;
	path0[j] := 0X; INC(j); i := 0;
	WHILE path[j] # 0X DO
		dirName[i] := path[j];
		INC(i); INC(j)
	END ;
	dirName[i] := 0X
END Split;
PROCEDURE 
Create* (path: ARRAY OF CHAR);
	absPath: ARRAY 256 OF CHAR;
	dirName: ARRAY 32 OF CHAR;
	lock: AmigaDos.FileLockPtr;
	done:BOOLEAN;
BEGIN
	COPY(path,absPath);
	lock :=  AmigaDos.CreateDir(absPath);
	IF lock#0 THEN
		AmigaDos.UnLock(lock);
		ExpandPath(absPath,absPath);
		Split(absPath, path,dirName);
		notify(insert,path,dirName);
		res:=noErr;
	ELSE
		res:=otherError;
END Create;
PROCEDURE 
Delete* (path: ARRAY OF CHAR);
	VAR absPath: ARRAY 256 OF CHAR; dirName: ARRAY 32 OF CHAR;
BEGIN
	ExpandPath(path,absPath);
	Files.Delete(absPath,res);
	IF res=0 THEN
		Split(absPath,path,dirName);
		notify(delete,path,dirName);
		res:=noErr;
	ELSE
		res:=otherError;
END Delete;
PROCEDURE 
Rename* (oldPath, newPath: ARRAY OF CHAR);
	oldPath0,newPath0:ARRAY 256 OF CHAR;
	oldName,newName:ARRAY 32 OF CHAR;
BEGIN
	res:=otherError;
	ExpandPath(oldPath,oldPath0);
	IF oldPath0[0]#0X THEN
		COPY(newPath,newPath0);
		Files.Rename(oldPath0,newPath0,res);
		IF res=0 THEN
			Split(oldPath0,oldPath,oldName);
			notify(delete,oldPath,oldName);
			ExpandPath(newPath0,newPath0);
			Split(newPath0,newPath,newName);
			notify(insert,newPath,newName);
			res:=noErr;
		ELSE
			res:=otherError;
		END
END Rename;
PROCEDURE 
EnumeratePaths* (proc: PathProc);
	VAR pathNo: LONGINT; continue: BOOLEAN; dir: Directory;
BEGIN
	pathNo := 0; continue := TRUE;
	WHILE continue & (pathNo < nofPaths) DO
		dir:=dirTab[pathNo];
		proc(dir.path, continue);
		INC(pathNo)
END EnumeratePaths;
PROCEDURE 
InitDirectories;
	dirCnt: INTEGER;
	buf: ARRAY 256 OF CHAR;
	file: AmigaDos.FileLockPtr;
BEGIN
	file := AmigaDos.Open("Paths", AmigaDos.oldFile);	(* Open configuration file *)
	IF file#0 THEN
		WHILE AmigaDos.FGets(file, buf, LEN(buf))#0 DO						(* Read the number of Paths *)
			IF buf[0]#";" THEN INC(nofPaths) END;									(* ignore comment lines *)
		END;
		NEW(dirTab, nofPaths);															(* allocate path table *)
		IF AmigaDos.Seek(file, 0, AmigaDos.beginning)#0 THEN END;		(* Move to beginning of file *)
		WHILE AmigaDos.FGets(file, buf, LEN(buf))#0 DO						(* Read in the path lines *)
			IF buf[0]#";" THEN 
				NEW(dirTab[dirCnt]);
				COPY(buf, dirTab[dirCnt].path);
				INC(dirCnt);
			END;
		END;
		IF AmigaDos.Close(file) THEN END;
	ELSE
		O.Str("Directories.InitDirectories: Cannot find `paths'!"); O.Ln;
	END;
	startupPath := "Oberon4Amiga:";
	CurrentDir:=This(startupPath);
END InitDirectories;
PROCEDURE 
NoNotify (op: INTEGER; path, name: ARRAY OF CHAR);
END NoNotify;
BEGIN
	notify := NoNotify;
	InitDirectories
END Directories.